Cream of the Crop 12/Cream of the Crop 12 (Part II)/Cream of the Crop 12 (Part II).iso/OS2/FTPFID16.ZIP/FTPSEND.CMD

Text File | 1996-02-22 | 20.8 KB | 695 lines

/* FTPFIDO.CMD - rexx script to get FidoNet mail via FTP */

/*------------------------------------------------------------------
 * Version 1.6send by Jerry Gause 1:3651/9
 * This version simply sends *.* from "ftpout" for
 * MFLO users.
 * Many thanks go to John Souvestre for the original base code
 * and of course to Patrick J. Mueller & Cliff Nadler for RxFtp.
 * Change global variables below to suit your system.
 * Change lines marked with "CFP!!!" to suit your provider.
 * Important!!!!!!!!!!!!!
 * Dlls needed for this script are: RxFtp, Rexxutil and Rexxlib.
 * Rxftp is included in it's own archive.
 * If using OS/2 2.X be sure to use the Rxftp32.Dll renamed
 * to Rxftp.dll.
 * Rexxlib was not included because it's shareware.
 * You can freq it from me as Rexxlb.Zip.
 * Lot's of error checking and logging of errors as well as normal
 * operation. If anything goes wrong, it is logged and the session
 * is aborted.
 *------------------------------------------------------------------*/

'@echo off'
host = "ftp.sstar.com"
name = ""
password = ""
seqfile  = 'f:\bbs\ftpfido.seq'
inbound = 'd:\ftpin2'   /* Binkley or FD secure inbound */
ftpin = 'd:\ftpin' /* Inbound for FTP */
ftpout = 'd:\ftpout' /* Outbound for FTP */
errlog = 'f:\bbs\logs\error.log' /* a logfile for errors */
bsy = 'f:\binkley\IHUB.BSY'      /* local file sent as remote busy flag */
remotebsyname = 'IHUB.BSY'    /* remote name for above */
avbps = 2000 /* Your average bps rate */
flg = 'f:\bbs\logs\Doing_ftp.flg' /* process flag */
logfile  = 'F:\bbs\logs\ftpfido.log' /* Drive containing logs */
listfile  = 'F:\bbs\logs\ftplist.log'
mailbundle = 'd:\ftpin\f349fff8.*' /* I only move mailbundles from ftpin to inbound. Change to *.* if you move all */
ndyet = 'd:\ftpin\ndyet.flg' /* Use this flag to prevent Allfix from running to prevent tics w/o files and vice versa */
tcpbin = 'd:\tcpip\bin' /* where hangup.cmd is located to terminate slip session */
hangup = 1  /* whether to hangup or not */
scrlgth = 25

'mode co80,'||scrlgth

bttm2 = scrlgth - 2
bttm3 = scrlgth - 3

total_received = 0
total_sent = 0
total_uls = 0
total_files = 0
sizethere = 0
howmucht = 0
howlongt = 0

UpperCase = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
LowerCase = 'abcdefghijklmnopqrstuvwxyz'

Signal on Syntax Name ErrorStop
Signal on Halt Name Abort
Signal on Failure Name FailureStop

rc = stream(logfile,'C','open write')

call Lineout logfile ,date('N') Time('N') 'FTPFIDO starting up.'

Call SysCurState Off
Call CopyInfo

if RxFuncQuery("FtpLoadFuncs") then
   do
   rc = RxFuncAdd("FtpLoadFuncs","RxFtp","FtpLoadFuncs")
   rc = FtpLoadFuncs(quiet)
   end

if RxFuncQuery("SysLoadFuncs") then
   do
   rc = RxFuncAdd("SysLoadFuncs","RexxUtil","SysLoadFuncs")
   rc = SysLoadFuncs()
   end

if RxFuncQuery("rexxlibregister") then
   do
   rc = RxFuncAdd('rexxlibregister','rexxlib','rexxlibregister')
   rc = rexxlibregister()
   end

IF Stream(flg,'C', 'Query Exists') <>' ' Then
    Do
  say '!Must be running already.'
rc = lineout(logfile,' Must be running already.')
 signal exit
    end
else
 do
rc=doscreat(flg) /* Set process flag */
IF rc <> 1 Then
    Do
  say '!Error creating flagfile.'
rc = lineout(logfile,'!Error creating flagfile.')
  signal exit
    end
 end

if hangup = 1 then do
New = Directory(tcpbin)
'start /fs /c /b hangup.cmd 'killme
end

killme = DosPid()
    Call SysCurPos 0,21
    say 'Process id: 'killme  'Begin: 'Time('N')''

/* Get the latest send sequence*/
seqstr = "0123456789abcdefghijklmnopqrstuvwxyz"
daywk = "mo tu we th fr sa su"

/* Contains the day and sequence*/
IF Stream(seqfile,'C', 'Query Exists') <>' ' Then
  Do
  line = LINEIN(seqfile)
  day = WORD(line, 1)
  if POS(day, daywk) = 0 then
    day = "mo"
  seq = WORD(line, 2)
  seqno = POS(seq, seqstr)
  if seqno = 0 then do
    seq = "0"
    seqno = 1
  end
 end
else do
  file = LINEOUT(seqfile, 'mo 0')
  seqno = 1
end
file = LINEOUT(seqfile)

rc = FtpSetBinary('Binary')

/*------------------------------------------------------------------
 * LOGON
 *------------------------------------------------------------------*/

rc = FtpSetUser(host, name, password)

stime = time('e')

attached = FtpSys(siteinfo)
Call SysCurPos 1,21
say ''attached ''
len = length(attached)
if len > 8 then                                               /* CFP!!! */
do
    Call SysCurPos 2,21
    rc = lineout(logfile,' Login successful')
    say 'Login successful '
    Call datetime

    rc = FtpChDir('..')                                         /* CFP!!! */

    rc = FtpPut(bsy,remotebsyname)
    if err <> -1 & FTPERRNO <> '0' then
    do
    say '!Error putting busy flag on remote.'
    rc = lineout(logfile,'!Error putting busy flag on remote.')
    signal abort
    end

/*------------------------------------------------------------------
 * Change to remote inbound directory.
 *------------------------------------------------------------------*/

    rc = FtpChDir("in")                                      /* CFP!!!! */
    if err <> -1 & FTPERRNO <> '0' then
    do
    say '!Error changing directory on remote.'
    rc = lineout(logfile,'!Error changing directory on remote.')
    signal abort
    end

/*------------------------------------------------------------------
 * Send Files
 *------------------------------------------------------------------*/

New=Directory(ftpout)

    rc = SysFileTree('*.*',outfile.,"F")
    if outfile.0 > 0 then
    do
        sizethere = 0
    x = 1
    do outfile.0    /* loop through all the files here */
         Call datetime

          ennd = scrlgth - 4
          if p > ennd then do
            p = ennd
            do until p = 5
            Call SysCurPos p,0
            say "                                                  "
            p = p - 1
            end /* do until */
           end

        filename = filespec("name", word(outfile.x,5))
        fullname = word(outfile.x,5)
        if filename <> '' & LENGTH(filename) > 3 & word(outfile.x,3) <> 0 then
        do
            /* Make sure the sequence is correct*/
        posfile = LASTPOS('.', filename) + 1
        setseq = SUBSTR(filename, posfile)
        fday = TRANSLATE(DELSTR(setseq, 3))
        fseq = TRANSLATE(SUBSTR(setseq, 3, 1))
        fseqno = POS(fseq, seqstr)

        /* Check if the days match*/
        if day = fday then
          do
        if fseqno > seqno then
            do
          seqno = fseqno
          seq = SUBSTR(seqstr, seqno, 1)
            end
          end
           else do
           day = fday
           seqno = fseqno
           if seqno = 0 then seqno = 1
           seq = SUBSTR(seqstr, seqno, 1)
            end

             remfile1 = DELSTR(filename, posfile)||day||seq

           Trunc = 0
           Nuke = 1

           Call Put filename fullname word(outfile.x,3) remfile1

        /* Update the sequence file*/
        'erase 'seqfile
        seqno = seqno + 1
        seq = SUBSTR(seqstr, seqno, 1)
        file = LINEOUT(seqfile, day' 'seq)
        file = LINEOUT(seqfile)
            end
           else
          do
          say '!'fullname' not found or 0 length.'
          rc = lineout(logfile,'!'fullname' not found or 0 length.')
          end
       x = x + 1
       p = p + 1
    end /* Do loop */
    end
    if sizethere = '0' then
    do
    say ' No mail/files to send at this time.'
    rc = lineout(logfile,' No mail/files to send at this time')
        p = p + 1
    end
end

/*------------------------------------------------------------------
 * Change to remote outbound directory.
 *------------------------------------------------------------------*/

    rc = FtpChDir("..")                                 /* CFP!!!! */
    if err <> -1 & FTPERRNO <> '0' then
    do
    say '!Error changing directory on remote.'
    rc = lineout(logfile,'!Error changing directory on remote.')
    signal abort
    end
    rc = FtpChDir("out")                                /* CFP!!!! */
    if err <> -1 & FTPERRNO <> '0' then
    do
    say '!Error changing directory on remote.'
    rc = lineout(logfile,'!Error changing directory on remote.')
    signal abort
    end


/*------------------------------------------------------------------
 * Get Mail and Files
 *------------------------------------------------------------------*/

    New=Directory(ftpin)
    rc = Ftpdir('*.*',infile.)  /* get list of files there for list */
      if infile.0 > 0 & rc = 0 then
   do
      y = 0
      'del 'listfile '> nul: 2>&1'
      rc = stream(listfile,'C','open write')
       total_bytes = 0
       do i = 1 to infile.0
    filename = word(infile.i,9)
    size = word(infile.i,5)
    total_bytes = total_bytes + size
    rc = LINEOUT(listfile, filename size)
        if y < bttm2 then do
    Call SysCurPos y,55
    say ''filename' -' size''
        end
        y = y + 1
       end
    rc = stream(listfile,'C','close')
    apxsecs = total_bytes%avbps
    apxmins = apxsecs%60
        bttm3 = scrlgth - 3
    Call SysCurPos bttm3,0
    say ' Receiving 'infile.0  'file(s) 'total_bytes' bytes 'apxmins' avg. mins.'
    rc = lineout(logfile,' Receiving 'infile.0 'file(s) 'total_bytes' bytes 'apxmins' avg. mins.')
    bps = 2000
    x = 1                       /* reset the pointer */

    /* time to get files here from There */
     do infile.0

     Call datetime

      ennd = scrlgth - 4
      if p > ennd then do
        p = ennd
        do until p = 5
        Call SysCurPos p,0
        say "                                                  "
        p = p - 1
        end /* do until */
       end

        filename = word(infile.x,9)

            if filename = "incoming" then  x = x + 1  /* CFP!!!! */
            if filename = "incoming" then iterate    /* CFP!!!! */

        Call Get filename word(infile.x,5)

    x = x + 1
    p = p + 1
     end /* Do loop */
 end
    else
    do
        Call SysCurPos p,0
    rc = lineout(logfile,' No files to get')
    say ' No files to get.'
    end

/*------------------------------------------------------------------
 * Change to remote root directory and remove busy flag.
 *------------------------------------------------------------------*/

    rc = FtpChDir('..')
    if err <> -1 & FTPERRNO <> '0' then
    do
    say '!Error changing directory on remote.'
    rc = lineout(logfile,'!Error changing directory on remote.')
    end
    rc = FtpDelete(remotebsyname)
    if err <> -1 & FTPERRNO <> '0' then
    do
    say '!Error deleting busy flag from remote.'
    rc = lineout(logfile,'!Error deleting busy flag from remote.')
    end

    signal done

end /* Login loop */
else
do
Call SysCurPos 1,28
    say '!Login failed... session aborted'
    rc = lineout(logfile,'!Login failed... session aborted')
    signal abort
end


/*------------------------------------------------------------------
 * SubRoutines
 *------------------------------------------------------------------*/

DateTime:
    Call SysCurPos 3,21
    say ''date('N') Time('N')''
Return

/*------------------------------------------------------------------
 * PUT
 *------------------------------------------------------------------*/

Put:
parse arg filehere fullname sizehere filethere
o = 1

Call SysCurPos p,0

filethere = translate(filethere, LowerCase, UpperCase)
if filehere <> filethere then
 do
   rc = lineout(logfile,' sending 'fullname '- 'sizehere 'bytes as 'filethere)
   say ' Sending 'filehere ' - 'sizehere' bytes as 'filethere''
 end
else
  do
    rc = lineout(logfile,' sending 'fullname '- 'sizehere 'bytes')
    say ' Sending 'filehere ' - 'sizehere' bytes '
  end

  ustart = time('e')

  err = FtpPut(fullname, filethere, 'binary')

  uelapsed = time('e')

  howmuch = strip(uelapsed-ustart,,0)
  bps = strip(format(sizehere/howmuch,10,0))

  if err = -1 & FTPERRNO = '0' then
  do
  /* add code to  test for good transfer by filesize */
    rc = FtpDir(filethere,test.)     /* get size from remote */
    if test.0 = 1 then /* it did get there  */
     do
    sizethere = word(test.1,5)
     if sizehere = sizethere then /* if the same size, delete or truncate if necessary */
      do
      p = p + 1
      Call SysCurPos p,0
      total_sent = total_sent + sizethere /* get size for report */
       howmucht = howmucht + howmuch
           total_uls = total_uls + 1
       Select
        When Trunc = 1 then
        do
        rc = lineout(logfile,' Successful - Truncating 'filehere)
        say ' Truncating 'filehere''
        rc=doscreat(fullname)
        IF rc <> 1 Then
          do
        say '!Error truncating 'fullname''
        rc = lineout(logfile,'!Error truncating 'fullname
        signal abort
          end
        end
        When Nuke = 1 then
        do
        rc = lineout(logfile,' Successful - Deleting 'fullname)
        say ' Deleting 'fullname''
        rc = SysFileDelete(fullname)
        IF rc <> 0 Then
          do
        say '!Error deleting 'fullname''
        rc = lineout(logfile,'!Error deleting 'fullname
        signal abort
          end
        end
       otherwise
       end /* Select */
        p = p + 1
        Call SysCurPos bttm2,0
        say "                                                  "
    Call SysCurPos bttm2,0
    say ' Sent 'total_uls 'file(s) 'total_sent 'bytes 'howmucht%60 'min. 'strip(format(howmucht//60,3,0)) 'secs.'
        Call SysCurPos p,0
        say 'Sent 'filehere '- 'howmuch%60 'min. 'strip(format(howmuch//60,3,0)) 'secs. 'bps 'bps.'
        rc = lineout(logfile,' sent 'filehere' - 'howmuch%60 'min. 'strip(format(howmuch//60,3,0)) 'secs. Baud = 'bps)
      end /* size */
    else
      do
        rc = lineout(logfile,'!Error in size - Deleting  'filethere 'from inbound')
        say '!Error in size - Deleting  'filethere 'from inbound'
        rc = FtpDelete(filethere)
        if err <> -1 & FTPERRNO <> '0' then
        do
        say '!Error deleting 'filethere 'from remote.'
        rc = lineout(logfile,'!Error deleting 'filethere 'from remote.')
        signal abort
        end
      end
     end /* test */
    else
       do
       say '!Error in filetest'
    rc = lineout(logfile,'!Error in filetest!')
       signal xabort
       end
  end
  else
   do
    say '!FTP returned error 'FTPERRNO''
    rc = lineout(logfile,'!FTP returned error 'FTPERRNO)
    signal xabort
    end

Return

/*------------------------------------------------------------------
 * GET
 *------------------------------------------------------------------*/

Get:
parse arg filename filesize

Call SysCurPos p,0

        say ' Recieving 'filename '- ' filesize 'bytes '
        start = time('e')
        err = FtpGet(filename, filename,"binary")    /* Transfer the file */
        elapsed = time('e')

        if err = -1 & FTPERRNO = '0' then
         do
             sizehere = stream(filename,'C','query size')    /* get the filesize here */
             if sizehere = filesize then
              do
            Call SysCurPos p,0
        say "                                                  "
            Call SysCurPos p,0
        howlong = strip(elapsed-start,,0)
        bps = strip(format(sizehere/howlong,10,0))
        say 'Recieved 'filename '- 'howlong%60 'min. 'strip(format(howlong//60,3,0)) 'secs. 'bps 'bps.'
        rc = lineout(logfile,' received 'filename' - 'sizehere' - 'howlong%60 'min. 'strip(format(howlong//60,3,0)) 'secs. Baud = 'bps)
        total_received = total_received + sizehere
        total_files = total_files + 1
        rc = FtpDelete(filename)
        if err <> -1 & FTPERRNO <> '0' then
        do
        say '!Error deleting 'filename 'from remote.'
        rc = lineout(logfile,'!Error deleting 'filename 'from remote.')
        end
        Call SysCurPos bttm2,0
        say "                                                  "
        Call SysCurPos bttm2,0
                howlongt = howlongt + howlong
        say ' Received 'total_files 'file(s) 'total_received 'bytes 'howlongt%60 'min. 'strip(format(howlongt//60,3,0)) 'secs.'
        if bps < 500 & filesize > 50000 then
        do
        say '!Something ain''t right!! too slow??'
        rc = lineout(logfile,'!Something went wrong with bps')
        signal abort
        end
              end /* size */
             else
             do
         say '!Error in filesize'
         rc = lineout(logfile,'!Error in filesize')
             x = x - 1
         end
         end
        else
        do
        say '!FTP returned error 'FTPERRNO''
        rc = lineout(logfile,'!FTP returned error 'FTPERRNO)
            signal xabort
        end

Return

/*------------------------------------------------------------------
 * Aborts
 *------------------------------------------------------------------*/

Xabort:
Call SysCurPos p,0
say '!File transfer failed..'
rc = lineout(logfile,'!File transfer failed..')

Abort:
Call SysCurPos 3,28
say '!Session Aborted'
rc = lineout(logfile,'!Session Aborted')

 rc= doscreat(ndyet)
if rc <> 1 Then
    Do
   say '!Error creating ndyet flag.'
   rc = lineout(logfile,'!Error creating ndyet flag.')
    end

    rc = FtpChDir('..')
    rc = FtpDelete(remotebsyname)

signal Abort1

/*------------------------------------------------------------------
 * DONE
 *------------------------------------------------------------------*/

Done:

IF Stream(mailbundle,'C', 'Query Exists') <>' ' Then
 do
 New=Directory(inbound)
 copy ftpin||'\*.* > nul: 2>&1'
 del ftpin||'\*.* /N > nul: 2>&1'
 end

/* 'echo mailproc | rxqueue mailproc' ------This triggers my mailtosser */

Abort1:

    rc = FtpSetUser("X","X","X")
    rc = FtpLogoff()
    rc = FtpDropFuncs()

Call SysCurPos bttm3,0
Say "                                                                               "
Call SysCurPos bttm2,0
Say "                                                                               "
Call SysCurPos bttm3,0

etime = time('e')

say ' Sent 'total_sent 'bytes, received 'total_received 'bytes in 'etime%60 'minutes, 'strip(format(etime//60,6,0)) 'seconds.'
rc = lineout(logfile, ' $Sent 'total_sent 'bytes, received 'total_received 'bytes in 'etime%60 'minutes, 'strip(format(etime//60,10,0)) 'seconds.' )
if total_sent > 0 then
do
say ' Total u/l time - 'howmucht%60 'min. 'strip(format(howmucht//60,3,0))' secs.  'strip(format(total_sent/howmucht,10,0))' avg. u/l bps.'
rc = lineout(logfile, ' Total u/l time - 'howmucht%60 'min. 'strip(format(howmucht//60,3,0))' secs.  'strip(format(total_sent/howmucht,10,0))' avg. u/l bps.')
end
if total_received > 0 then
do
say ' Total d/l time - 'howlongt%60 'min. 'strip(format(howlongt//60,3,0))' secs.  'strip(format(total_received/howlongt,10,0))' avg. d/l bps.'
say ' Sent 'total_uls 'files(s) Received 'total_files 'file(s).'
rc = lineout(logfile, ' Total d/l time - 'howlongt%60 'min. 'strip(format(howlongt//60,3,0))' secs.  'strip(format(total_received/howlongt,10,0))' avg. d/l bps.')
rc = lineout(logfile, ' Sent 'total_uls 'file(s) Received 'total_files 'file(s).')
end

    /* remove process flag */
      'del 'flg '> nul: 2>&1'
       IF rc <> 0 Then
       Do
       say '!Error deleting 'flg''
       rc = lineout(logfile,'!Error deleting 'flg)
       end

    /* remove ndyet flag */
     IF Stream(ndyet,'C', 'Query Exists') <>' ' Then
      Do
      'del 'ndyet' > nul: 2>&1'
       IF rc <> 0 Then
       Do
       say '!Error deleting ndyet.flg'
       rc = lineout(logfile,'!Error deleting ndyet.flg')
       end
      end

call Lineout logfile ,date('N') Time('N') 'FTPFIDO closing down.'

rc = stream(logfile,'C','close')

exit


CopyInfo: Procedure

Call SysCls

Say '    ░░░░▒▒▒▒▓▓▓▓████'
Say '      FTPFido'
Say '   By Jerry Gause'
Say 'Warped Software'
Say '████▓▓▓▓▒▒▒▒░░░░    '
Say ''
Return

FailureStop:
parse upper source tst
tst=word(tst,3)
tst=parsefn(tst)
tst=word(tst,3)'.'word(tst,4)
      say 'A Failure ('RC') has occurred on Line 'Sigl' in 'tst''
      say 'ftpfido has Failure Exited'
      call Lineout errlog ,date('N') Time('N') ':  ftpfido ,  A Failure ('RC') has occurred on Line 'Sigl' in 'tst
   Signal Exit

ErrorStop:
parse upper source tst
tst=word(tst,3)
tst=parsefn(tst)
tst=word(tst,3)'.'word(tst,4)
      say 'An Error ('RC') has occurred on Line 'Sigl' in 'tst''
      say 'ftpfido has Error Exited'
      call Lineout errlog ,date('N') Time('N') ':  ftpfido , An Error ('RC') has occurred on Line 'Sigl' in 'tst

exit:
if hangup = 1 then do
New = Directory(tcpbin)
'start /fs /c /b hangup.cmd 'killme
end
rc = stream(errlog,'C','close')
rc = stream(logfile,'C','close')
exit